home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / C / Applications / MacPerl 5.0.3 / MacPerl Source ƒ / Perl5 / x2p / a2py.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-09-05  |  24.3 KB  |  1,295 lines  |  [TEXT/MPS ]
  1. /* $RCSfile: a2py.c,v $$Revision: 4.1 $$Date: 92/08/07 18:29:14 $
  2.  *
  3.  *    Copyright (c) 1991, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  * $Log:    a2py.c,v $
  9.  */
  10.  
  11. #ifdef macintosh
  12. #include <QuickDraw.h>
  13. #endif
  14.  
  15. #ifdef OS2
  16. #include "../patchlevel.h"
  17. #endif
  18. #include "util.h"
  19. char *strchr();
  20.  
  21. char *filename;
  22. char *myname;
  23.  
  24. int checkers = 0;
  25. STR *walk();
  26.  
  27. #ifdef OS2
  28. usage()
  29. {
  30.     printf("\nThis is the AWK to PERL translator, version 5.0, patchlevel %d\n", PATCHLEVEL);
  31.     printf("\nUsage: %s [-D<number>] [-F<char>] [-n<fieldlist>] [-<number>] filename\n", myname);
  32.     printf("\n  -D<number>      sets debugging flags."
  33.            "\n  -F<character>   the awk script to translate is always invoked with"
  34.            "\n                  this -F switch."
  35.            "\n  -n<fieldlist>   specifies the names of the input fields if input does"
  36.            "\n                  not have to be split into an array."
  37.            "\n  -<number>       causes a2p to assume that input will always have that"
  38.            "\n                  many fields.\n");
  39.     exit(1);
  40. }
  41. #endif
  42. main(argc,argv,env)
  43. register int argc;
  44. register char **argv;
  45. register char **env;
  46. {
  47.     register STR *str;
  48.     register char *s;
  49.     int i;
  50.     STR *tmpstr;
  51.  
  52. #ifdef macintosh
  53.     InitGraf(&qd.thePort);
  54. #endif
  55.  
  56.     myname = argv[0];
  57.     linestr = str_new(80);
  58.     str = str_new(0);        /* first used for -I flags */
  59.     for (argc--,argv++; argc; argc--,argv++) {
  60.     if (argv[0][0] != '-' || !argv[0][1])
  61.         break;
  62.       reswitch:
  63.     switch (argv[0][1]) {
  64. #ifdef DEBUGGING
  65.     case 'D':
  66.         debug = atoi(argv[0]+2);
  67. #ifdef YYDEBUG
  68.         yydebug = (debug & 1);
  69. #endif
  70.         break;
  71. #endif
  72.     case '0': case '1': case '2': case '3': case '4':
  73.     case '5': case '6': case '7': case '8': case '9':
  74.         maxfld = atoi(argv[0]+1);
  75.         absmaxfld = TRUE;
  76.         break;
  77.     case 'F':
  78.         fswitch = argv[0][2];
  79.         break;
  80.     case 'n':
  81.         namelist = savestr(argv[0]+2);
  82.         break;
  83.     case '-':
  84.         argc--,argv++;
  85.         goto switch_end;
  86.     case 0:
  87.         break;
  88.     default:
  89.         fatal("Unrecognized switch: %s\n",argv[0]);
  90. #ifdef OS2
  91.             usage();
  92. #endif
  93.     }
  94.     }
  95.   switch_end:
  96.  
  97.     /* open script */
  98.  
  99.     if (argv[0] == Nullch) {
  100. #ifdef OS2
  101.     if ( isatty(fileno(stdin)) )
  102.         usage();
  103. #endif
  104.         argv[0] = "-";
  105.     }
  106.     filename = savestr(argv[0]);
  107.  
  108.     filename = savestr(argv[0]);
  109.     if (strEQ(filename,"-"))
  110.     argv[0] = "";
  111.     if (!*argv[0])
  112.     rsfp = stdin;
  113.     else
  114.     rsfp = fopen(argv[0],"r");
  115.     if (rsfp == Nullfp)
  116.     fatal("Awk script \"%s\" doesn't seem to exist.\n",filename);
  117.  
  118.     /* init tokener */
  119.  
  120.     bufptr = str_get(linestr);
  121.     symtab = hnew();
  122.     curarghash = hnew();
  123.  
  124.     /* now parse the report spec */
  125.  
  126.     if (yyparse())
  127.     fatal("Translation aborted due to syntax errors.\n");
  128.  
  129. #ifdef DEBUGGING
  130.     if (debug & 2) {
  131.     int type, len;
  132.  
  133.     for (i=1; i<mop;) {
  134.         type = ops[i].ival;
  135.         len = type >> 8;
  136.         type &= 255;
  137.         printf("%d\t%d\t%d\t%-10s",i++,type,len,opname[type]);
  138.         if (type == OSTRING)
  139.         printf("\t\"%s\"\n",ops[i].cval),i++;
  140.         else {
  141.         while (len--) {
  142.             printf("\t%d",ops[i].ival),i++;
  143.         }
  144.         putchar('\n');
  145.         }
  146.     }
  147.     }
  148.     if (debug & 8)
  149.     dump(root);
  150. #endif
  151.  
  152.     /* first pass to look for numeric variables */
  153.  
  154.     prewalk(0,0,root,&i);
  155.  
  156.     /* second pass to produce new program */
  157.  
  158.     tmpstr = walk(0,0,root,&i,P_MIN);
  159.     str = str_make("#!");
  160.     str_cat(str, BIN);
  161.     str_cat(str, "/perl\neval \"exec ");
  162.     str_cat(str, BIN);
  163.     str_cat(str, "/perl -S $0 $*\"\n\
  164.     if $running_under_some_shell;\n\
  165.             # this emulates #! processing on NIH machines.\n\
  166.             # (remove #! line above if indigestible)\n\n");
  167.     str_cat(str,
  168.       "eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_0-9]+=)(.*)/ && shift;\n");
  169.     str_cat(str,
  170.       "            # process any FOO=bar switches\n\n");
  171.     if (do_opens && opens) {
  172.     str_scat(str,opens);
  173.     str_free(opens);
  174.     str_cat(str,"\n");
  175.     }
  176.     str_scat(str,tmpstr);
  177.     str_free(tmpstr);
  178. #ifdef DEBUGGING
  179.     if (!(debug & 16))
  180. #endif
  181.     fixup(str);
  182.     putlines(str);
  183.     if (checkers) {
  184.     fprintf(stderr,
  185.       "Please check my work on the %d line%s I've marked with \"#???\".\n",
  186.         checkers, checkers == 1 ? "" : "s" );
  187.     fprintf(stderr,
  188.       "The operation I've selected may be wrong for the operand types.\n");
  189.     }
  190.     exit(0);
  191. }
  192.  
  193. #define RETURN(retval) return (bufptr = s,retval)
  194. #define XTERM(retval) return (expectterm = TRUE,bufptr = s,retval)
  195. #define XOP(retval) return (expectterm = FALSE,bufptr = s,retval)
  196. #define ID(x) return (yylval=string(x,0),expectterm = FALSE,bufptr = s,idtype)
  197.  
  198. int idtype;
  199.  
  200. yylex()
  201. {
  202.     register char *s = bufptr;
  203.     register char *d;
  204.     register int tmp;
  205.  
  206.   retry:
  207. #ifdef YYDEBUG
  208.     if (yydebug)
  209.     if (strchr(s,'\n'))
  210.         fprintf(stderr,"Tokener at %s",s);
  211.     else
  212.         fprintf(stderr,"Tokener at %s\n",s);
  213. #endif
  214.     switch (*s) {
  215.     default:
  216.     fprintf(stderr,
  217.         "Unrecognized character %c in file %s line %d--ignoring.\n",
  218.          *s++,filename,line);
  219.     goto retry;
  220.     case '\\':
  221.     s++;
  222.     if (*s && *s != '\n') {
  223.         yyerror("Ignoring spurious backslash");
  224.         goto retry;
  225.     }
  226.     /*FALLSTHROUGH*/
  227.     case 0:
  228.     s = str_get(linestr);
  229.     *s = '\0';
  230.     if (!rsfp)
  231.         RETURN(0);
  232.     line++;
  233.     if ((s = str_gets(linestr, rsfp)) == Nullch) {
  234.         if (rsfp != stdin)
  235.         fclose(rsfp);
  236.         rsfp = Nullfp;
  237.         s = str_get(linestr);
  238.         RETURN(0);
  239.     }
  240.     goto retry;
  241.     case ' ': case '\t':
  242.     s++;
  243.     goto retry;
  244.     case '\n':
  245.     *s = '\0';
  246.     XTERM(NEWLINE);
  247.     case '#':
  248.     yylval = string(s,0);
  249.     *s = '\0';
  250.     XTERM(COMMENT);
  251.     case ';':
  252.     tmp = *s++;
  253.     if (*s == '\n') {
  254.         s++;
  255.         XTERM(SEMINEW);
  256.     }
  257.     XTERM(tmp);
  258.     case '(':
  259.     tmp = *s++;
  260.     XTERM(tmp);
  261.     case '{':
  262.     case '[':
  263.     case ')':
  264.     case ']':
  265.     case '?':
  266.     case ':':
  267.     tmp = *s++;
  268.     XOP(tmp);
  269.     case 127:
  270.     s++;
  271.     XTERM('}');
  272.     case '}':
  273.     for (d = s + 1; isspace(*d); d++) ;
  274.     if (!*d)
  275.         s = d - 1;
  276.     *s = 127;
  277.     XTERM(';');
  278.     case ',':
  279.     tmp = *s++;
  280.     XTERM(tmp);
  281.     case '~':
  282.     s++;
  283.     yylval = string("~",1);
  284.     XTERM(MATCHOP);
  285.     case '+':
  286.     case '-':
  287.     if (s[1] == *s) {
  288.         s++;
  289.         if (*s++ == '+')
  290.         XTERM(INCR);
  291.         else
  292.         XTERM(DECR);
  293.     }
  294.     /* FALL THROUGH */
  295.     case '*':
  296.     case '%':
  297.     case '^':
  298.     tmp = *s++;
  299.     if (*s == '=') {
  300.         if (tmp == '^')
  301.         yylval = string("**=",3);
  302.         else
  303.         yylval = string(s-1,2);
  304.         s++;
  305.         XTERM(ASGNOP);
  306.     }
  307.     XTERM(tmp);
  308.     case '&':
  309.     s++;
  310.     tmp = *s++;
  311.     if (tmp == '&')
  312.         XTERM(ANDAND);
  313.     s--;
  314.     XTERM('&');
  315.     case '|':
  316.     s++;
  317.     tmp = *s++;
  318.     if (tmp == '|')
  319.         XTERM(OROR);
  320.     s--;
  321.     while (*s == ' ' || *s == '\t')
  322.         s++;
  323.     if (strnEQ(s,"getline",7))
  324.         XTERM('p');
  325.     else
  326.         XTERM('|');
  327.     case '=':
  328.     s++;
  329.     tmp = *s++;
  330.     if (tmp == '=') {
  331.         yylval = string("==",2);
  332.         XTERM(RELOP);
  333.     }
  334.     s--;
  335.     yylval = string("=",1);
  336.     XTERM(ASGNOP);
  337.     case '!':
  338.     s++;
  339.     tmp = *s++;
  340.     if (tmp == '=') {
  341.         yylval = string("!=",2);
  342.         XTERM(RELOP);
  343.     }
  344.     if (tmp == '~') {
  345.         yylval = string("!~",2);
  346.         XTERM(MATCHOP);
  347.     }
  348.     s--;
  349.     XTERM(NOT);
  350.     case '<':
  351.     s++;
  352.     tmp = *s++;
  353.     if (tmp == '=') {
  354.         yylval = string("<=",2);
  355.         XTERM(RELOP);
  356.     }
  357.     s--;
  358.     XTERM('<');
  359.     case '>':
  360.     s++;
  361.     tmp = *s++;
  362.     if (tmp == '>') {
  363.         yylval = string(">>",2);
  364.         XTERM(GRGR);
  365.     }
  366.     if (tmp == '=') {
  367.         yylval = string(">=",2);
  368.         XTERM(RELOP);
  369.     }
  370.     s--;
  371.     XTERM('>');
  372.  
  373. #define SNARFWORD \
  374.     d = tokenbuf; \
  375.     while (isalpha(*s) || isdigit(*s) || *s == '_') \
  376.         *d++ = *s++; \
  377.     *d = '\0'; \
  378.     d = tokenbuf; \
  379.     if (*s == '(') \
  380.         idtype = USERFUN; \
  381.     else \
  382.         idtype = VAR;
  383.  
  384.     case '$':
  385.     s++;
  386.     if (*s == '0') {
  387.         s++;
  388.         do_chop = TRUE;
  389.         need_entire = TRUE;
  390.         idtype = VAR;
  391.         ID("0");
  392.     }
  393.     do_split = TRUE;
  394.     if (isdigit(*s)) {
  395.         for (d = s; isdigit(*s); s++) ;
  396.         yylval = string(d,s-d);
  397.         tmp = atoi(d);
  398.         if (tmp > maxfld)
  399.         maxfld = tmp;
  400.         XOP(FIELD);
  401.     }
  402.     split_to_array = set_array_base = TRUE;
  403.     XOP(VFIELD);
  404.  
  405.     case '/':            /* may either be division or pattern */
  406.     if (expectterm) {
  407.         s = scanpat(s);
  408.         XTERM(REGEX);
  409.     }
  410.     tmp = *s++;
  411.     if (*s == '=') {
  412.         yylval = string("/=",2);
  413.         s++;
  414.         XTERM(ASGNOP);
  415.     }
  416.     XTERM(tmp);
  417.  
  418.     case '0': case '1': case '2': case '3': case '4':
  419.     case '5': case '6': case '7': case '8': case '9': case '.':
  420.     s = scannum(s);
  421.     XOP(NUMBER);
  422.     case '"':
  423.     s++;
  424.     s = cpy2(tokenbuf,s,s[-1]);
  425.     if (!*s)
  426.         fatal("String not terminated:\n%s",str_get(linestr));
  427.     s++;
  428.     yylval = string(tokenbuf,0);
  429.     XOP(STRING);
  430.  
  431.     case 'a': case 'A':
  432.     SNARFWORD;
  433.     if (strEQ(d,"ARGC"))
  434.         set_array_base = TRUE;
  435.     if (strEQ(d,"ARGV")) {
  436.         yylval=numary(string("ARGV",0));
  437.         XOP(VAR);
  438.     }
  439.     if (strEQ(d,"atan2")) {
  440.         yylval = OATAN2;
  441.         XTERM(FUNN);
  442.     }
  443.     ID(d);
  444.     case 'b': case 'B':
  445.     SNARFWORD;
  446.     if (strEQ(d,"break"))
  447.         XTERM(BREAK);
  448.     if (strEQ(d,"BEGIN"))
  449.         XTERM(BEGIN);
  450.     ID(d);
  451.     case 'c': case 'C':
  452.     SNARFWORD;
  453.     if (strEQ(d,"continue"))
  454.         XTERM(CONTINUE);
  455.     if (strEQ(d,"cos")) {
  456.         yylval = OCOS;
  457.         XTERM(FUN1);
  458.     }
  459.     if (strEQ(d,"close")) {
  460.         do_fancy_opens = 1;
  461.         yylval = OCLOSE;
  462.         XTERM(FUN1);
  463.     }
  464.     if (strEQ(d,"chdir"))
  465.         *d = toupper(*d);
  466.     else if (strEQ(d,"crypt"))
  467.         *d = toupper(*d);
  468.     else if (strEQ(d,"chop"))
  469.         *d = toupper(*d);
  470.     else if (strEQ(d,"chmod"))
  471.         *d = toupper(*d);
  472.     else if (strEQ(d,"chown"))
  473.         *d = toupper(*d);
  474.     ID(d);
  475.     case 'd': case 'D':
  476.     SNARFWORD;
  477.     if (strEQ(d,"do"))
  478.         XTERM(DO);
  479.     if (strEQ(d,"delete"))
  480.         XTERM(DELETE);
  481.     if (strEQ(d,"die"))
  482.         *d = toupper(*d);
  483.     ID(d);
  484.     case 'e': case 'E':
  485.     SNARFWORD;
  486.     if (strEQ(d,"END"))
  487.         XTERM(END);
  488.     if (strEQ(d,"else"))
  489.         XTERM(ELSE);
  490.     if (strEQ(d,"exit")) {
  491.         saw_line_op = TRUE;
  492.         XTERM(EXIT);
  493.     }
  494.     if (strEQ(d,"exp")) {
  495.         yylval = OEXP;
  496.         XTERM(FUN1);
  497.     }
  498.     if (strEQ(d,"elsif"))
  499.         *d = toupper(*d);
  500.     else if (strEQ(d,"eq"))
  501.         *d = toupper(*d);
  502.     else if (strEQ(d,"eval"))
  503.         *d = toupper(*d);
  504.     else if (strEQ(d,"eof"))
  505.         *d = toupper(*d);
  506.     else if (strEQ(d,"each"))
  507.         *d = toupper(*d);
  508.     else if (strEQ(d,"exec"))
  509.         *d = toupper(*d);
  510.     ID(d);
  511.     case 'f': case 'F':
  512.     SNARFWORD;
  513.     if (strEQ(d,"FS")) {
  514.         saw_FS++;
  515.         if (saw_FS == 1 && in_begin) {
  516.         for (d = s; *d && isspace(*d); d++) ;
  517.         if (*d == '=') {
  518.             for (d++; *d && isspace(*d); d++) ;
  519.             if (*d == '"' && d[2] == '"')
  520.             const_FS = d[1];
  521.         }
  522.         }
  523.         ID(tokenbuf);
  524.     }
  525.     if (strEQ(d,"for"))
  526.         XTERM(FOR);
  527.     else if (strEQ(d,"function"))
  528.         XTERM(FUNCTION);
  529.     if (strEQ(d,"FILENAME"))
  530.         d = "ARGV";
  531.     if (strEQ(d,"foreach"))
  532.         *d = toupper(*d);
  533.     else if (strEQ(d,"format"))
  534.         *d = toupper(*d);
  535.     else if (strEQ(d,"fork"))
  536.         *d = toupper(*d);
  537.     else if (strEQ(d,"fh"))
  538.         *d = toupper(*d);
  539.     ID(d);
  540.     case 'g': case 'G':
  541.     SNARFWORD;
  542.     if (strEQ(d,"getline"))
  543.         XTERM(GETLINE);
  544.     if (strEQ(d,"gsub"))
  545.         XTERM(GSUB);
  546.     if (strEQ(d,"ge"))
  547.         *d = toupper(*d);
  548.     else if (strEQ(d,"gt"))
  549.         *d = toupper(*d);
  550.     else if (strEQ(d,"goto"))
  551.         *d = toupper(*d);
  552.     else if (strEQ(d,"gmtime"))
  553.         *d = toupper(*d);
  554.     ID(d);
  555.     case 'h': case 'H':
  556.     SNARFWORD;
  557.     if (strEQ(d,"hex"))
  558.         *d = toupper(*d);
  559.     ID(d);
  560.     case 'i': case 'I':
  561.     SNARFWORD;
  562.     if (strEQ(d,"if"))
  563.         XTERM(IF);
  564.     if (strEQ(d,"in"))
  565.         XTERM(IN);
  566.     if (strEQ(d,"index")) {
  567.         set_array_base = TRUE;
  568.         XTERM(INDEX);
  569.     }
  570.     if (strEQ(d,"int")) {
  571.         yylval = OINT;
  572.         XTERM(FUN1);
  573.     }
  574.     ID(d);
  575.     case 'j': case 'J':
  576.     SNARFWORD;
  577.     if (strEQ(d,"join"))
  578.         *d = toupper(*d);
  579.     ID(d);
  580.     case 'k': case 'K':
  581.     SNARFWORD;
  582.     if (strEQ(d,"keys"))
  583.         *d = toupper(*d);
  584.     else if (strEQ(d,"kill"))
  585.         *d = toupper(*d);
  586.     ID(d);
  587.     case 'l': case 'L':
  588.     SNARFWORD;
  589.     if (strEQ(d,"length")) {
  590.         yylval = OLENGTH;
  591.         XTERM(FUN1);
  592.     }
  593.     if (strEQ(d,"log")) {
  594.         yylval = OLOG;
  595.         XTERM(FUN1);
  596.     }
  597.     if (strEQ(d,"last"))
  598.         *d = toupper(*d);
  599.     else if (strEQ(d,"local"))
  600.         *d = toupper(*d);
  601.     else if (strEQ(d,"lt"))
  602.         *d = toupper(*d);
  603.     else if (strEQ(d,"le"))
  604.         *d = toupper(*d);
  605.     else if (strEQ(d,"locatime"))
  606.         *d = toupper(*d);
  607.     else if (strEQ(d,"link"))
  608.         *d = toupper(*d);
  609.     ID(d);
  610.     case 'm': case 'M':
  611.     SNARFWORD;
  612.     if (strEQ(d,"match")) {
  613.         set_array_base = TRUE;
  614.         XTERM(MATCH);
  615.     }
  616.     if (strEQ(d,"m"))
  617.         *d = toupper(*d);
  618.     ID(d);
  619.     case 'n': case 'N':
  620.     SNARFWORD;
  621.     if (strEQ(d,"NF"))
  622.         do_chop = do_split = split_to_array = set_array_base = TRUE;
  623.     if (strEQ(d,"next")) {
  624.         saw_line_op = TRUE;
  625.         XTERM(NEXT);
  626.     }
  627.     if (strEQ(d,"ne"))
  628.         *d = toupper(*d);
  629.     ID(d);
  630.     case 'o': case 'O':
  631.     SNARFWORD;
  632.     if (strEQ(d,"ORS")) {
  633.         saw_ORS = TRUE;
  634.         d = "\\";
  635.     }
  636.     if (strEQ(d,"OFS")) {
  637.         saw_OFS = TRUE;
  638.         d = ",";
  639.     }
  640.     if (strEQ(d,"OFMT")) {
  641.         d = "#";
  642.     }
  643.     if (strEQ(d,"open"))
  644.         *d = toupper(*d);
  645.     else if (strEQ(d,"ord"))
  646.         *d = toupper(*d);
  647.     else if (strEQ(d,"oct"))
  648.         *d = toupper(*d);
  649.     ID(d);
  650.     case 'p': case 'P':
  651.     SNARFWORD;
  652.     if (strEQ(d,"print")) {
  653.         XTERM(PRINT);
  654.     }
  655.     if (strEQ(d,"printf")) {
  656.         XTERM(PRINTF);
  657.     }
  658.     if (strEQ(d,"push"))
  659.         *d = toupper(*d);
  660.     else if (strEQ(d,"pop"))
  661.         *d = toupper(*d);
  662.     ID(d);
  663.     case 'q': case 'Q':
  664.     SNARFWORD;
  665.     ID(d);
  666.     case 'r': case 'R':
  667.     SNARFWORD;
  668.     if (strEQ(d,"RS")) {
  669.         d = "/";
  670.         saw_RS = TRUE;
  671.     }
  672.     if (strEQ(d,"rand")) {
  673.         yylval = ORAND;
  674.         XTERM(FUN1);
  675.     }
  676.     if (strEQ(d,"return"))
  677.         XTERM(RET);
  678.     if (strEQ(d,"reset"))
  679.         *d = toupper(*d);
  680.     else if (strEQ(d,"redo"))
  681.         *d = toupper(*d);
  682.     else if (strEQ(d,"rename"))
  683.         *d = toupper(*d);
  684.     ID(d);
  685.     case 's': case 'S':
  686.     SNARFWORD;
  687.     if (strEQ(d,"split")) {
  688.         set_array_base = TRUE;
  689.         XOP(SPLIT);
  690.     }
  691.     if (strEQ(d,"substr")) {
  692.         set_array_base = TRUE;
  693.         XTERM(SUBSTR);
  694.     }
  695.     if (strEQ(d,"sub"))
  696.         XTERM(SUB);
  697.     if (strEQ(d,"sprintf"))
  698.         XTERM(SPRINTF);
  699.     if (strEQ(d,"sqrt")) {
  700.         yylval = OSQRT;
  701.         XTERM(FUN1);
  702.     }
  703.     if (strEQ(d,"SUBSEP")) {
  704.         d = ";";
  705.     }
  706.     if (strEQ(d,"sin")) {
  707.         yylval = OSIN;
  708.         XTERM(FUN1);
  709.     }
  710.     if (strEQ(d,"srand")) {
  711.         yylval = OSRAND;
  712.         XTERM(FUN1);
  713.     }
  714.     if (strEQ(d,"system")) {
  715.         yylval = OSYSTEM;
  716.         XTERM(FUN1);
  717.     }
  718.     if (strEQ(d,"s"))
  719.         *d = toupper(*d);
  720.     else if (strEQ(d,"shift"))
  721.         *d = toupper(*d);
  722.     else if (strEQ(d,"select"))
  723.         *d = toupper(*d);
  724.     else if (strEQ(d,"seek"))
  725.         *d = toupper(*d);
  726.     else if (strEQ(d,"stat"))
  727.         *d = toupper(*d);
  728.     else if (strEQ(d,"study"))
  729.         *d = toupper(*d);
  730.     else if (strEQ(d,"sleep"))
  731.         *d = toupper(*d);
  732.     else if (strEQ(d,"symlink"))
  733.         *d = toupper(*d);
  734.     else if (strEQ(d,"sort"))
  735.         *d = toupper(*d);
  736.     ID(d);
  737.     case 't': case 'T':
  738.     SNARFWORD;
  739.     if (strEQ(d,"tr"))
  740.         *d = toupper(*d);
  741.     else if (strEQ(d,"tell"))
  742.         *d = toupper(*d);
  743.     else if (strEQ(d,"time"))
  744.         *d = toupper(*d);
  745.     else if (strEQ(d,"times"))
  746.         *d = toupper(*d);
  747.     ID(d);
  748.     case 'u': case 'U':
  749.     SNARFWORD;
  750.     if (strEQ(d,"until"))
  751.         *d = toupper(*d);
  752.     else if (strEQ(d,"unless"))
  753.         *d = toupper(*d);
  754.     else if (strEQ(d,"umask"))
  755.         *d = toupper(*d);
  756.     else if (strEQ(d,"unshift"))
  757.         *d = toupper(*d);
  758.     else if (strEQ(d,"unlink"))
  759.         *d = toupper(*d);
  760.     else if (strEQ(d,"utime"))
  761.         *d = toupper(*d);
  762.     ID(d);
  763.     case 'v': case 'V':
  764.     SNARFWORD;
  765.     if (strEQ(d,"values"))
  766.         *d = toupper(*d);
  767.     ID(d);
  768.     case 'w': case 'W':
  769.     SNARFWORD;
  770.     if (strEQ(d,"while"))
  771.         XTERM(WHILE);
  772.     if (strEQ(d,"write"))
  773.         *d = toupper(*d);
  774.     else if (strEQ(d,"wait"))
  775.         *d = toupper(*d);
  776.     ID(d);
  777.     case 'x': case 'X':
  778.     SNARFWORD;
  779.     if (strEQ(d,"x"))
  780.         *d = toupper(*d);
  781.     ID(d);
  782.     case 'y': case 'Y':
  783.     SNARFWORD;
  784.     if (strEQ(d,"y"))
  785.         *d = toupper(*d);
  786.     ID(d);
  787.     case 'z': case 'Z':
  788.     SNARFWORD;
  789.     ID(d);
  790.     }
  791. }
  792.  
  793. char *
  794. scanpat(s)
  795. register char *s;
  796. {
  797.     register char *d;
  798.  
  799.     switch (*s++) {
  800.     case '/':
  801.     break;
  802.     default:
  803.     fatal("Search pattern not found:\n%s",str_get(linestr));
  804.     }
  805.  
  806.     d = tokenbuf;
  807.     for (; *s; s++,d++) {
  808.     if (*s == '\\') {
  809.         if (s[1] == '/')
  810.         *d++ = *s++;
  811.         else if (s[1] == '\\')
  812.         *d++ = *s++;
  813.         else if (s[1] == '[')
  814.         *d++ = *s++;
  815.     }
  816.     else if (*s == '[') {
  817.         *d++ = *s++;
  818.         do {
  819.         if (*s == '\\' && s[1])
  820.             *d++ = *s++;
  821.         if (*s == '/' || (*s == '-' && s[1] == ']'))
  822.             *d++ = '\\';
  823.         *d++ = *s++;
  824.         } while (*s && *s != ']');
  825.     }
  826.     else if (*s == '/')
  827.         break;
  828.     *d = *s;
  829.     }
  830.     *d = '\0';
  831.  
  832.     if (!*s)
  833.     fatal("Search pattern not terminated:\n%s",str_get(linestr));
  834.     s++;
  835.     yylval = string(tokenbuf,0);
  836.     return s;
  837. }
  838.  
  839. yyerror(s)
  840. char *s;
  841. {
  842.     fprintf(stderr,"%s in file %s at line %d\n",
  843.       s,filename,line);
  844. }
  845.  
  846. char *
  847. scannum(s)
  848. register char *s;
  849. {
  850.     register char *d;
  851.  
  852.     switch (*s) {
  853.     case '1': case '2': case '3': case '4': case '5':
  854.     case '6': case '7': case '8': case '9': case '0' : case '.':
  855.     d = tokenbuf;
  856.     while (isdigit(*s)) {
  857.         *d++ = *s++;
  858.     }
  859.     if (*s == '.') {
  860.         if (isdigit(s[1])) {
  861.         *d++ = *s++;
  862.         while (isdigit(*s)) {
  863.             *d++ = *s++;
  864.         }
  865.         }
  866.         else
  867.         s++;
  868.     }
  869.     if (strchr("eE",*s) && strchr("+-0123456789",s[1])) {
  870.         *d++ = *s++;
  871.         if (*s == '+' || *s == '-')
  872.         *d++ = *s++;
  873.         while (isdigit(*s))
  874.         *d++ = *s++;
  875.     }
  876.     *d = '\0';
  877.     yylval = string(tokenbuf,0);
  878.     break;
  879.     }
  880.     return s;
  881. }
  882.  
  883. string(ptr,len)
  884. char *ptr;
  885. {
  886.     int retval = mop;
  887.  
  888.     ops[mop++].ival = OSTRING + (1<<8);
  889.     if (!len)
  890.     len = strlen(ptr);
  891.     ops[mop].cval = safemalloc(len+1);
  892.     strncpy(ops[mop].cval,ptr,len);
  893.     ops[mop++].cval[len] = '\0';
  894.     if (mop >= OPSMAX)
  895.     fatal("Recompile a2p with larger OPSMAX\n");
  896.     return retval;
  897. }
  898.  
  899. oper0(type)
  900. int type;
  901. {
  902.     int retval = mop;
  903.  
  904.     if (type > 255)
  905.     fatal("type > 255 (%d)\n",type);
  906.     ops[mop++].ival = type;
  907.     if (mop >= OPSMAX)
  908.     fatal("Recompile a2p with larger OPSMAX\n");
  909.     return retval;
  910. }
  911.  
  912. oper1(type,arg1)
  913. int type;
  914. int arg1;
  915. {
  916.     int retval = mop;
  917.  
  918.     if (type > 255)
  919.     fatal("type > 255 (%d)\n",type);
  920.     ops[mop++].ival = type + (1<<8);
  921.     ops[mop++].ival = arg1;
  922.     if (mop >= OPSMAX)
  923.     fatal("Recompile a2p with larger OPSMAX\n");
  924.     return retval;
  925. }
  926.  
  927. oper2(type,arg1,arg2)
  928. int type;
  929. int arg1;
  930. int arg2;
  931. {
  932.     int retval = mop;
  933.  
  934.     if (type > 255)
  935.     fatal("type > 255 (%d)\n",type);
  936.     ops[mop++].ival = type + (2<<8);
  937.     ops[mop++].ival = arg1;
  938.     ops[mop++].ival = arg2;
  939.     if (mop >= OPSMAX)
  940.     fatal("Recompile a2p with larger OPSMAX\n");
  941.     return retval;
  942. }
  943.  
  944. oper3(type,arg1,arg2,arg3)
  945. int type;
  946. int arg1;
  947. int arg2;
  948. int arg3;
  949. {
  950.     int retval = mop;
  951.  
  952.     if (type > 255)
  953.     fatal("type > 255 (%d)\n",type);
  954.     ops[mop++].ival = type + (3<<8);
  955.     ops[mop++].ival = arg1;
  956.     ops[mop++].ival = arg2;
  957.     ops[mop++].ival = arg3;
  958.     if (mop >= OPSMAX)
  959.     fatal("Recompile a2p with larger OPSMAX\n");
  960.     return retval;
  961. }
  962.  
  963. oper4(type,arg1,arg2,arg3,arg4)
  964. int type;
  965. int arg1;
  966. int arg2;
  967. int arg3;
  968. int arg4;
  969. {
  970.     int retval = mop;
  971.  
  972.     if (type > 255)
  973.     fatal("type > 255 (%d)\n",type);
  974.     ops[mop++].ival = type + (4<<8);
  975.     ops[mop++].ival = arg1;
  976.     ops[mop++].ival = arg2;
  977.     ops[mop++].ival = arg3;
  978.     ops[mop++].ival = arg4;
  979.     if (mop >= OPSMAX)
  980.     fatal("Recompile a2p with larger OPSMAX\n");
  981.     return retval;
  982. }
  983.  
  984. oper5(type,arg1,arg2,arg3,arg4,arg5)
  985. int type;
  986. int arg1;
  987. int arg2;
  988. int arg3;
  989. int arg4;
  990. int arg5;
  991. {
  992.     int retval = mop;
  993.  
  994.     if (type > 255)
  995.     fatal("type > 255 (%d)\n",type);
  996.     ops[mop++].ival = type + (5<<8);
  997.     ops[mop++].ival = arg1;
  998.     ops[mop++].ival = arg2;
  999.     ops[mop++].ival = arg3;
  1000.     ops[mop++].ival = arg4;
  1001.     ops[mop++].ival = arg5;
  1002.     if (mop >= OPSMAX)
  1003.     fatal("Recompile a2p with larger OPSMAX\n");
  1004.     return retval;
  1005. }
  1006.  
  1007. int depth = 0;
  1008.  
  1009. dump(branch)
  1010. int branch;
  1011. {
  1012.     register int type;
  1013.     register int len;
  1014.     register int i;
  1015.  
  1016.     type = ops[branch].ival;
  1017.     len = type >> 8;
  1018.     type &= 255;
  1019.     for (i=depth; i; i--)
  1020.     printf(" ");
  1021.     if (type == OSTRING) {
  1022.     printf("%-5d\"%s\"\n",branch,ops[branch+1].cval);
  1023.     }
  1024.     else {
  1025.     printf("(%-5d%s %d\n",branch,opname[type],len);
  1026.     depth++;
  1027.     for (i=1; i<=len; i++)
  1028.         dump(ops[branch+i].ival);
  1029.     depth--;
  1030.     for (i=depth; i; i--)
  1031.         printf(" ");
  1032.     printf(")\n");
  1033.     }
  1034. }
  1035.  
  1036. bl(arg,maybe)
  1037. int arg;
  1038. int maybe;
  1039. {
  1040.     if (!arg)
  1041.     return 0;
  1042.     else if ((ops[arg].ival & 255) != OBLOCK)
  1043.     return oper2(OBLOCK,arg,maybe);
  1044.     else if ((ops[arg].ival >> 8) < 2)
  1045.     return oper2(OBLOCK,ops[arg+1].ival,maybe);
  1046.     else
  1047.     return arg;
  1048. }
  1049.  
  1050. fixup(str)
  1051. STR *str;
  1052. {
  1053.     register char *s;
  1054.     register char *t;
  1055.  
  1056.     for (s = str->str_ptr; *s; s++) {
  1057.     if (*s == ';' && s[1] == ' ' && s[2] == '\n') {
  1058.         strcpy(s+1,s+2);
  1059.         s++;
  1060.     }
  1061.     else if (*s == '\n') {
  1062.         for (t = s+1; isspace(*t & 127); t++) ;
  1063.         t--;
  1064.         while (isspace(*t & 127) && *t != '\n') t--;
  1065.         if (*t == '\n' && t-s > 1) {
  1066.         if (s[-1] == '{')
  1067.             s--;
  1068.         strcpy(s+1,t);
  1069.         }
  1070.         s++;
  1071.     }
  1072.     }
  1073. }
  1074.  
  1075. putlines(str)
  1076. STR *str;
  1077. {
  1078.     register char *d, *s, *t, *e;
  1079.     register int pos, newpos;
  1080.  
  1081.     d = tokenbuf;
  1082.     pos = 0;
  1083.     for (s = str->str_ptr; *s; s++) {
  1084.     *d++ = *s;
  1085.     pos++;
  1086.     if (*s == '\n') {
  1087.         *d = '\0';
  1088.         d = tokenbuf;
  1089.         pos = 0;
  1090.         putone();
  1091.     }
  1092.     else if (*s == '\t')
  1093.         pos += 7;
  1094.     if (pos > 78) {        /* split a long line? */
  1095.         *d-- = '\0';
  1096.         newpos = 0;
  1097.         for (t = tokenbuf; isspace(*t & 127); t++) {
  1098.         if (*t == '\t')
  1099.             newpos += 8;
  1100.         else
  1101.             newpos += 1;
  1102.         }
  1103.         e = d;
  1104.         while (d > tokenbuf && (*d != ' ' || d[-1] != ';'))
  1105.         d--;
  1106.         if (d < t+10) {
  1107.         d = e;
  1108.         while (d > tokenbuf &&
  1109.           (*d != ' ' || d[-1] != '|' || d[-2] != '|') )
  1110.             d--;
  1111.         }
  1112.         if (d < t+10) {
  1113.         d = e;
  1114.         while (d > tokenbuf &&
  1115.           (*d != ' ' || d[-1] != '&' || d[-2] != '&') )
  1116.             d--;
  1117.         }
  1118.         if (d < t+10) {
  1119.         d = e;
  1120.         while (d > tokenbuf && (*d != ' ' || d[-1] != ','))
  1121.             d--;
  1122.         }
  1123.         if (d < t+10) {
  1124.         d = e;
  1125.         while (d > tokenbuf && *d != ' ')
  1126.             d--;
  1127.         }
  1128.         if (d > t+3) {
  1129.                 char save[2048];
  1130.                 strcpy(save, d);
  1131.         *d = '\n';
  1132.                 d[1] = '\0';
  1133.         putone();
  1134.         putchar('\n');
  1135.         if (d[-1] != ';' && !(newpos % 4)) {
  1136.             *t++ = ' ';
  1137.             *t++ = ' ';
  1138.             newpos += 2;
  1139.         }
  1140.         strcpy(t,save+1);
  1141.         newpos += strlen(t);
  1142.         d = t + strlen(t);
  1143.         pos = newpos;
  1144.         }
  1145.         else
  1146.         d = e + 1;
  1147.     }
  1148.     }
  1149. }
  1150.  
  1151. putone()
  1152. {
  1153.     register char *t;
  1154.  
  1155.     for (t = tokenbuf; *t; t++) {
  1156.     *t &= 127;
  1157.     if (*t == 127) {
  1158.         *t = ' ';
  1159.         strcpy(t+strlen(t)-1, "\t#???\n");
  1160.         checkers++;
  1161.     }
  1162.     }
  1163.     t = tokenbuf;
  1164.     if (*t == '#') {
  1165.     if (strnEQ(t,"#!/bin/awk",10) || strnEQ(t,"#! /bin/awk",11))
  1166.         return;
  1167.     if (strnEQ(t,"#!/usr/bin/awk",14) || strnEQ(t,"#! /usr/bin/awk",15))
  1168.         return;
  1169.     }
  1170.     fputs(tokenbuf,stdout);
  1171. }
  1172.  
  1173. numary(arg)
  1174. int arg;
  1175. {
  1176.     STR *key;
  1177.     int dummy;
  1178.  
  1179.     key = walk(0,0,arg,&dummy,P_MIN);
  1180.     str_cat(key,"[]");
  1181.     hstore(symtab,key->str_ptr,str_make("1"));
  1182.     str_free(key);
  1183.     set_array_base = TRUE;
  1184.     return arg;
  1185. }
  1186.  
  1187. rememberargs(arg)
  1188. int arg;
  1189. {
  1190.     int type;
  1191.     STR *str;
  1192.  
  1193.     if (!arg)
  1194.     return arg;
  1195.     type = ops[arg].ival & 255;
  1196.     if (type == OCOMMA) {
  1197.     rememberargs(ops[arg+1].ival);
  1198.     rememberargs(ops[arg+3].ival);
  1199.     }
  1200.     else if (type == OVAR) {
  1201.     str = str_new(0);
  1202.     hstore(curarghash,ops[ops[arg+1].ival+1].cval,str);
  1203.     }
  1204.     else
  1205.     fatal("panic: unknown argument type %d, line %d\n",type,line);
  1206.     return arg;
  1207. }
  1208.  
  1209. aryrefarg(arg)
  1210. int arg;
  1211. {
  1212.     int type = ops[arg].ival & 255;
  1213.     STR *str;
  1214.  
  1215.     if (type != OSTRING)
  1216.     fatal("panic: aryrefarg %d, line %d\n",type,line);
  1217.     str = hfetch(curarghash,ops[arg+1].cval);
  1218.     if (str)
  1219.     str_set(str,"*");
  1220.     return arg;
  1221. }
  1222.  
  1223. fixfargs(name,arg,prevargs)
  1224. int name;
  1225. int arg;
  1226. int prevargs;
  1227. {
  1228.     int type;
  1229.     STR *str;
  1230.     int numargs;
  1231.  
  1232.     if (!arg)
  1233.     return prevargs;
  1234.     type = ops[arg].ival & 255;
  1235.     if (type == OCOMMA) {
  1236.     numargs = fixfargs(name,ops[arg+1].ival,prevargs);
  1237.     numargs = fixfargs(name,ops[arg+3].ival,numargs);
  1238.     }
  1239.     else if (type == OVAR) {
  1240.     str = hfetch(curarghash,ops[ops[arg+1].ival+1].cval);
  1241.     if (strEQ(str_get(str),"*")) {
  1242.         char tmpbuf[128];
  1243.  
  1244.         str_set(str,"");        /* in case another routine has this */
  1245.         ops[arg].ival &= ~255;
  1246.         ops[arg].ival |= OSTAR;
  1247.         sprintf(tmpbuf,"%s:%d",ops[name+1].cval,prevargs);
  1248.         fprintf(stderr,"Adding %s\n",tmpbuf);
  1249.         str = str_new(0);
  1250.         str_set(str,"*");
  1251.         hstore(curarghash,tmpbuf,str);
  1252.     }
  1253.     numargs = prevargs + 1;
  1254.     }
  1255.     else
  1256.     fatal("panic: unknown argument type %d, arg %d, line %d\n",
  1257.       type,prevargs+1,line);
  1258.     return numargs;
  1259. }
  1260.  
  1261. fixrargs(name,arg,prevargs)
  1262. char *name;
  1263. int arg;
  1264. int prevargs;
  1265. {
  1266.     int type;
  1267.     STR *str;
  1268.     int numargs;
  1269.  
  1270.     if (!arg)
  1271.     return prevargs;
  1272.     type = ops[arg].ival & 255;
  1273.     if (type == OCOMMA) {
  1274.     numargs = fixrargs(name,ops[arg+1].ival,prevargs);
  1275.     numargs = fixrargs(name,ops[arg+3].ival,numargs);
  1276.     }
  1277.     else {
  1278.     char tmpbuf[128];
  1279.  
  1280.     sprintf(tmpbuf,"%s:%d",name,prevargs);
  1281.     str = hfetch(curarghash,tmpbuf);
  1282.     if (str && strEQ(str->str_ptr,"*")) {
  1283.         if (type == OVAR || type == OSTAR) {
  1284.         ops[arg].ival &= ~255;
  1285.         ops[arg].ival |= OSTAR;
  1286.         }
  1287.         else
  1288.         fatal("Can't pass expression by reference as arg %d of %s\n",
  1289.             prevargs+1, name);
  1290.     }
  1291.     numargs = prevargs + 1;
  1292.     }
  1293.     return numargs;
  1294. }
  1295.